home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / gus / vts139b.zip / SONGUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-24  |  5KB  |  191 lines
  1. UNIT SongUtils;
  2.  
  3. INTERFACE
  4.  
  5. USES SongUnit, SongElements;
  6.  
  7.  
  8.  
  9.  
  10. {----------------------------------------------------------------------------}
  11. { Definitions for accelerating the use of note periods.                      }
  12. {____________________________________________________________________________}
  13.  
  14. CONST
  15.   NumberOctaves = 6;
  16.   NumberNotes   = 12;
  17.   NumberPeriods = NumberOctaves * NumberNotes;
  18.  
  19. TYPE
  20.   TPeriodSet = ARRAY[0..NumberOctaves-1] OF         { Octave }
  21.                ARRAY[0..NumberNotes  -1] OF WORD;   { Note   }
  22.  
  23.   TPeriodArray = ARRAY[0..NumberPeriods - 1] OF WORD;
  24.  
  25. CONST
  26.   { The different note values. }
  27.  
  28.   PeriodSet : TPeriodSet = (
  29.     {  C     C#    D     D#    E     F     F#    G     G#    A     A#    B  }
  30.     ($06B0,$0650,$05F5,$05A0,$054F,$0503,$04BB,$0477,$0436,$03FA,$03C1,$038B),
  31.     ($0358,$0328,$02FB,$02D0,$02A7,$0281,$025D,$023B,$021B,$01FD,$01E0,$01C5),
  32.     ($01AC,$0194,$017D,$0168,$0154,$0141,$012F,$011E,$010E,$00FE,$00F0,$00E3),
  33.     ($00D6,$00CA,$00BF,$00B4,$00AA,$00A0,$0097,$008F,$0087,$007F,$0078,$0071),
  34.     ($006B,$0065,$005F,$005A,$0055,$0050,$004C,$0047,$0043,$0040,$003C,$0039),
  35.     ($0035,$0032,$0030,$002D,$002A,$0028,$0026,$0024,$0022,$0020,$001E,$001C)
  36. {
  37.     ($001B,$0019,$0018,$0016,$0015,$0014,$0013,$0012,$0011,$0010,$000F,$000E)
  38. }
  39.   );
  40.  
  41.   { The different inter-note values. }
  42.  
  43.   PeriodDiff : TPeriodSet = (
  44.     ($0680,$0622,$05CA,$0577,$0529,$04DF,$0499,$0456,$0418,$03DD,$03A6,$0371),
  45.     ($0340,$0311,$02E5,$02BB,$0294,$026F,$024C,$022B,$020C,$01EE,$01D2,$01B8),
  46.     ($01A0,$0188,$0172,$015E,$014A,$0138,$0126,$0116,$0106,$00F7,$00E9,$00DC),
  47.     ($00D0,$00C4,$00B9,$00AF,$00A5,$009B,$0093,$008B,$0083,$007B,$0074,$006E),
  48.     ($0068,$0062,$005C,$0057,$0052,$004E,$0049,$0045,$0041,$003E,$003A,$0037),
  49.     ($0033,$0031,$002E,$002B,$0029,$0027,$0025,$0023,$0021,$001F,$001D,$001B)
  50. {
  51.     ($001A,$0018,$0017,$0015,$0014,$0013,$0012,$0011,$0010,$000F,$000E,$000E)
  52. }
  53.   );
  54.  
  55. VAR
  56.   PeriodArray : TPeriodArray ABSOLUTE PeriodSet;
  57.  
  58. TYPE
  59.   TNoteString    = STRING[3];
  60.  
  61.   TNoteSet       = ARRAY[0..2047] OF WORD;
  62.   TNoteStringSet = ARRAY[0..NumberPeriods] OF TNoteString;
  63.  
  64. VAR
  65.   NoteIdx : TNoteSet;       { For each period, specifies its closest note, in two ways:      }
  66.                             {   Hi byte: octave in the hi nibble and note in the low nibble. }
  67.                             {  Low byte: sequential note for indexing.                       }
  68.  
  69.   NoteStr : TNoteStringSet; { The strings for each note (e.g. 'A#2'). }
  70.  
  71.  
  72.  
  73.  
  74. FUNCTION  SwapLong (l: LONGINT)                  : LONGINT;
  75. PROCEDURE NoteFreq (f: WORD; VAR s: TNoteString);
  76.  
  77. PROCEDURE InitModVideoTables;
  78. PROCEDURE InitModUnit;
  79.  
  80. FUNCTION  FullNotesEqual (VAR fn1, fn2: TFullNote) : BOOLEAN;
  81.  
  82.  
  83.  
  84. IMPLEMENTATION
  85.  
  86.  
  87.  
  88.  
  89.  
  90. FUNCTION SwapLong(l: LONGINT) : LONGINT;
  91.   VAR
  92.     w : ARRAY[0..1] OF WORD ABSOLUTE l;
  93.     r : WORD;
  94.   BEGIN
  95.     r    := SWAP(w[0]);
  96.     w[0] := SWAP(w[1]);
  97.     w[1] := r;
  98.     SwapLong := l;
  99.   END;
  100.  
  101.  
  102.  
  103.  
  104. PROCEDURE NoteFreq(f: WORD; VAR s: TNoteString);
  105.   BEGIN
  106.     IF f > 2047 THEN
  107.       f := 2047;
  108.  
  109.     s := NoteStr[NoteIdx[f] AND $FF];
  110. {    STR(f, s);}
  111.   END;
  112.  
  113.  
  114.  
  115.  
  116. {----------------------------------------------------------------------------}
  117. { Initialization routines.                                                   }
  118. {____________________________________________________________________________}
  119.  
  120. PROCEDURE InitModUnit;
  121.   VAR
  122.     l    : LONGINT;
  123.     f,
  124.     o, i : WORD;
  125.   LABEL
  126.     Octava, NextFreq;
  127.   BEGIN
  128.     FOR f := 0 TO 2047 DO BEGIN
  129.  
  130.       FOR o := 0 TO NumberOctaves-1 DO
  131.         IF f > PeriodDiff[o][11] THEN GOTO Octava;
  132.       i := 0; o := 0;
  133.       GOTO NextFreq;
  134.  
  135. Octava:
  136.       FOR i := 0 TO NumberNotes-1 DO
  137.         IF f > PeriodDiff[o][i]  THEN GOTO NextFreq;
  138.       i := 0; o := 0;
  139.  
  140. NextFreq:
  141.       NoteIdx[f] := (o*16+i)*256 + (o*12+i)
  142.  
  143.     END;
  144.   END;
  145.  
  146.  
  147.  
  148.  
  149. PROCEDURE InitModVideoTables;
  150.   CONST
  151.     NoteLet : STRING[12] = 'CCDDEFFGGAAB';
  152.     NoteSus : STRING[12] = ' # #  # # # ';
  153.   VAR
  154.     o, i : WORD;
  155.     s    : STRING[3];
  156.   BEGIN
  157.      FOR i := 0 TO NumberPeriods-1 DO BEGIN
  158.        s[0] := CHR(3);
  159.        o    := i DIV 12;
  160.        s[3] := CHR(o + ORD('0'));
  161.        o    := i MOD 12 + 1;
  162.        s[1] := NoteLet[o];
  163.        s[2] := NoteSus[o];
  164.  
  165.        NoteStr[i] := s;
  166.      END;
  167.  
  168.      NoteStr[NumberPeriods] := '---';
  169.   END;
  170.  
  171.  
  172.  
  173.  
  174. FUNCTION  FullNotesEqual (VAR fn1, fn2: TFullNote) : BOOLEAN;
  175.   TYPE
  176.     TFNArray = ARRAY[1..SizeOf(TFullNote)] OF BYTE;
  177.   VAR
  178.     fna1 : TFNArray ABSOLUTE fn1;
  179.     fna2 : TFNArray ABSOLUTE fn2;
  180.     i    : WORD;
  181.   BEGIN
  182.     FullNotesEqual := FALSE;
  183.     FOR i := 1 TO SizeOf(TFullNote) DO
  184.       IF fna1[i] <> fna2[i] THEN EXIT;
  185.     FullNotesEqual := TRUE;
  186.   END;
  187.  
  188.  
  189.  
  190.  
  191. END.